# Definition and implementation of the Part class and its subclasses: Act, Sketch, Scene, Play, Chapter.

itcl::class Part {

	constructor {attributes} {
		set iAttributes [iarray::code [iarray::Array #auto $attributes]]
		set iResources [iarray::code [iarray::Array #auto]]
	}
	destructor {
		itcl::delete object $iAttributes
		itcl::delete object $iResources
	}
	method copy {} {
		set duplicate [iarray::code [[info class] #auto [getAttributes]]]
		foreach {key varList} [getResources] {
			foreach var $varList {
				$duplicate addResource $key $var
			}
		}
		return $duplicate
	}

	method getAttributes {} {
		$iAttributes get
	}
	method updateAttributes {attributes} {
		$iAttributes set $attributes
	}
	method removeAttributes {attributes} {
		foreach attribute $attributes {
			$iAttributes rename $attribute ""
		}
	}
	method hasAttributes {attributes} {
		set result {}
		foreach attribute $attributes {
			if [$iAttributes has $attribute] {
				lappend result $attribute
			}
		}
		return $result
	}
	method hasAttribute {attribute} {
		$iAttributes has $attribute
	}
	method getAttribute {attribute} {
		$iAttributes of $attribute
	}
	method parseAttributes {line} {
		set line [string trim $line]
		if {[string length $iAttribute]} {
			append iLine " $line"
			if {[catch {set value [Story::fromValue $iLine line]}]} return
			$iAttributes set $iAttribute $value
			set iAttribute ""
		}
		while {[string length $line]} {
			set iAttribute [Story::fromName $line iLine]
			if {![string length $iLine]} return
			if [catch {set value [Story::fromValue $iLine line]}] return
			$iAttributes set $iAttribute $value
			set iAttribute ""
		}
	}

	method addReference {key path variables} {
		set textReference "[Story::toText $key] [Story::toTextList $path] [Story::toTextList $variables]"
		if {![$iAttributes has references]} {
			$iAttributes set references $textReference
		} else {
			$iAttributes set references "[$iAttributes of references] $textReference"
		}
	}
	method removeReference {key} {
		assert [$iAttributes has references] {
			Unable to remove <$key> from an empty list of references.
		}
		set textReferences [$iAttributes of references]
		assert [string length $textReferences] {
			Unable to remove <$key> from an empty list of references.
		}
		set currentKey [Story::fromText $textReferences textReferences]
		set currentPath [Story::fromTextList $textReferences textReferences]
		set currentVariables [Story::fromTextList $textReferences textReferences]
		if {[string equal $currentKey $key]} {
			set textReferences [string trim $textReferences]
			if [string length $textReferences] {
				$iAttributes set references $textReferences
			} else {
				$iAttributes unset references
			}
			return
		}
		
		set frontTextReferences "[Story::toText $currentKey] [Story::toTextList $currentPath] [Story::toTextList $currentVariables]"
		while {[string length $textReferences]} {
			set currentKey [Story::fromText $textReferences textReferences]
			set currentPath [Story::fromTextList $textReferences textReferences]
			set currentVariables [Story::fromTextList $textReferences textReferences]
			if {[string equal $currentKey $key]} {
				$iAttributes set references "$frontTextReferences$textReferences"
				return
			}
			append frontTextReferences " [Story::toText $currentKey] [Story::toTextList $currentPath] [Story::toTextList $currentVariables]"
		}
		
		# Not found. Report.
		assert 0 {
			Unable to find and remove <$key> from the list of references.
		}
	}
	method getReferences {} {
		if {![$iAttributes has references]} {return {}}
		set textReferences [$iAttributes of references]
		set references {}
		while {[string length $textReferences]} {
			lappend references \
				[Story::fromText $textReferences textReferences] \
				[Story::fromTextList $textReferences textReferences] \
				[Story::fromTextList $textReferences textReferences]
		}
		return $references
	}

	protected method assignTributes {tributes} {
		set iTributes [iarray::code [iarray::Array #auto $tributes]]
		$iTributes set [$iAttributes get]
	}
	protected method releaseTributes {} {
		itcl::delete object $iTributes
		set iTributes {}
	}
	method getTributes {} {
		if {![llength $iTributes]} {return {}}
		$iTributes get
	}

	method getResources {} {
		$iResources get
	}
	method addResource {key value} {
		if [$iResources has $key] {
			if {[lsearch [$iResources of $key] $value] == -1} {
				$iResources set $key [concat [$iResources of $key] [list $value]]
			}
		} else {
			$iResources set $key $value
		}
	}
	method removeResource {key value} {
		if {![$iResources has $key]} return
		if {[set found [lsearch [$iResources of $key] $value]] == -1} return
		if {[llength [$iResources of $key] == 1} {
			$iResources rename $key ""
			return
		}
		$iResources set $key [lreplace [$iResources of $key] $found $found]
	}

	method addFont {key} {
		if {![$iAttributes has fonts]} {
			$iAttributes set fonts [Story::toText $key]
		} else {
			$iAttributes set fonts "[$iAttributes of fonts] [Story::toText $key]"
		}
	}
	method removeFont {key} {
		assert [$iAttributes has fonts] {
			Unable to remove <$key> from an empty list of fonts.
		}
		set textFonts [$iAttributes of fonts]
		assert [string length $textFonts] {
			Unable to remove <$key> from an empty list of fonts.
		}
		set currentKey [Story::fromText $textFonts textFonts]
		if {[string equal $currentKey $key]} {
			set textFonts [string trim $textFonts]
			if [string length $textFonts] {
				$iAttributes set fonts $textFonts
			} else {
				$iAttributes unset fonts
			}
			return
		}
		
		set frontTextFonts [Story::toText $currentKey]
		while {[string length $textFonts]} {
			set currentKey [Story::fromText $textFonts textFonts]
			if {[string equal $currentKey $key]} {
				$iAttributes set fonts "$frontTextFonts$textFonts"
				return
			}
			append frontTextFonts " [Story::toText $currentKey]"
		}
		
		# Not found. Report.
		assert 0 {
			Unable to find and remove <$key> from the list of fonts.
		}
	}
	method getFonts {} {
		if {![$iAttributes has fonts]} {return {}}
		set textFonts [$iAttributes of fonts]
		set fonts {}
		while {[string length $textFonts]} {
			lappend fonts \
				[Story::fromText $textFonts textFonts]
		}
		return $fonts
	}

	method hasSequence {} {return 0}
	method getSequence {} {
		assert 0 {
			No sequence available.
		}
	}

	method isEmpty {} {return 1}

	method findPart {path} {
		if {![llength $path]} {return this}
		set sequence [getSequence]
		foreach key [lrange $path 0 end-1] {
			assert [$sequence has $key] {
				The key <$key> in the path <$path> is not found under this [info class].
			}
			set part [$sequence of $key]
			assert [$part isa Part] {
				The key <$key> in the path <$path> is not a proper Part.
			}
			assert [$part hasSequence] {
				The key <$key> in the path <$path> does not contain a sequence.
			}
			set sequence [$part getSequence]
		}
		set key [lindex $path end]
		assert [$sequence has $key] {
			The final key <$key> in the path <$path> is not found under this [info class] which contains <[$sequence names]>.
		}	
		set part [$sequence of $key]
		assert [$part isa Part] {
			The <$key> element is not a proper Part.
		}
		return $part
	}

	# Subclasses that automatically generate variables should do so in their doResolve
	# or resolve method. When done, references are scanned and the corresponding variables
	# are added as attributes. As such, automatically generated variables should never
	# depend on referenced variables.
	# Call this method before pruning or (if there's no pruning), before writing.
	method resolve {tributes} {
		assignTributes $tributes
		doResolve

		# Now that all variables are filled in, resolve all references.
		set attributes {}
		foreach {key path variables} [getReferences] {
			foreach {variable value} [doDereference $path $variables] {
				lappend attributes "\$$key$variable" $value
			}
		}
		updateAttributes $attributes

		releaseTributes
	}
	protected method doResolve {} {}

	method dereference {tributes path variables} {
		assignTributes $tributes
		set attributes [doDereference $path $variables]
		releaseTributes

		return $attributes
	}

	protected method doDereference {path variables} {
		if {[llength $path] == 0} {
			set attributes {}
			foreach variable $variables {
				lappend attributes $variable [evaluate \$$variable]
			}
			return $attributes
		} else {
			set key [lindex $path 0]
			set sequence [getSequence]
			assert [$sequence has $key] {
				The key <$key> in the path <$path> is not found under this [info class].
			}
			[$sequence of $key] dereference [$iTributes get] [lrange $path 1 end] $variables
		}
	}

	method prune {tributes} {
		assignTributes $tributes
		set variables {}
		doPrune variables
		releaseTributes
		
		# Prune out those variables in the attribute list which are not mentioned in the variables list.
		# Remove those variables in the variables list which are in the attribute list.
		set unused {}
		foreach {attribute value} [getAttributes] {
			if {![string equal -length 1 $attribute "\$"]} continue
			set found [lsearch $variables $attribute]
			if {$found == -1} {
				lappend unused $attribute
			} else {
				set variables [lreplace $variables $found $found]
			}
		}

		removeAttributes $unused

		# Remove unused fonts
		foreach key [getFonts] {
			if {[string equal -length 1 $attribute "\$"] && \
				([lsearch $variables $key] != -1)} {
				removeFont $key 
			}
		}

		return $variables
	}
	protected method doPrune {variablesPtr} {}

	method collect {tributes fontsPtr} {
		upvar $fontsPtr fonts
		assignTributes $tributes
		doCollect fonts
		releaseTributes
	}
	protected method doCollect {fontsPtr} {
		upvar $fontsPtr fonts
		foreach key [getFonts] {
			set font [evaluate $key]
			if {[lsearch $fonts $font] == -1} {
				lappend fonts [evaluate $key]
			}
		}
	}

	method autoRead {I tributes} {
		assignTributes $tributes
		doRead $I
		releaseTributes
		assert {![string length $iAttribute]} {
			Problem parsing the value for attribute <$iAttribute>. Remainder: <$iLine>.
		}
	}
	protected method doRead {I} {}
	method autoWrite {U tributes} {
		assignTributes $tributes
		doWrite $U
		releaseTributes
	}
	protected method doWrite {U} {}

	# Helper method for pruning variables. Assumes iTributes set. Call from within doPrune.
	# Detects which variables are used in the tokens recursively, and adds them to the list.
	protected method detect {tokens variablesPtr} {
		upvar $variablesPtr variables
		doDetect $tokens variables {}
	}

	private method doDetect {tokens variablesPtr resolveList} {
		upvar $variablesPtr variables
		set allTokens $tokens
		while {[string length $tokens]} {
			set token [Story::tokenize $tokens tokens]
			# Remove leading slash.
			regsub "^/" $token "" token
			if {[string equal -length 1 $token "\$"]} {
				# Remove format modifiers.
				regexp "\[^#\]+" $token token
				if {[lsearch $variables $token] != -1} continue
				lappend variables $token
				if {![$iTributes has $token]} continue
				assert {[lsearch $resolveList $token] == -1} {
					Recursive dependence of token <$token> on itself, while detecting <$allTokens> against list <$resolveList>.
				}
				doDetect [$iTributes of $token] variables [concat $resolveList [list $token]]
			} elseif {[regexp "^\\\{(.+)\\\}#\[1-9]?$" $token dummy double]} {
				doDetect $double variables $resolveList
			}
		}
	}

	# Helper method for reading and writing output. Assumes iTributes set. Call from within doRead and doWrite.
	# Replaces variables in the tokens with their values in the tribute list recursively, simplifying
	# things it can evaluate and returns the result.
	# If supplied with an extra parameter, fills in whether any variable replacement has happened.
	protected method evaluate {tokens args} {
		if [llength $args] {upvar [lindex $args 0] replaced}
		set tokenized {}
		set stack {}
		set replaced [doEvaluate $tokens tokenized stack {}]
		Story::simplify $tokenized stack {}
	}

	private method doEvaluate {tokens tokenizedPtr stackPtr resolveList} {
		upvar $tokenizedPtr tokenized
		upvar $stackPtr stack
		set replaced 0
		set allTokens $tokens
		while {[string length $tokens]} {
			set token [Story::tokenize $tokens tokens]
			if {[string equal -length 1 $token "\$"]} {
				# Check format.
				if {[regexp "^(\[^#\]+)#(\[1-9]?)$" $token dummy double precision]} {
					# Double with precision. Try to resolve to a double and reduce the fractional part.
					if {[$iTributes has $double]} {
						assert {[lsearch $resolveList $double] == -1} {
							Recursive dependency of double token <$double> on itself, while evaluating <$allTokens> against list <$resolveList>.
						}
						set replaced 1
						set toDouble {}
						doEvaluate [$iTributes of $double] tokenized toDouble [concat $resolveList [list $double]]
						assert {[string is double -strict $toDouble]} {
							<$double> didn't resolve to a double, but to <$toDouble>.
						}
						if {[string length $precision]} {
							lappend stack [Story::dedouble $toDouble $precision]
						} else {
							lappend stack [Story::dedouble $toDouble]
						}
						continue
					}
					# Not found? Remove the format.
					set token $double
				} elseif {[$iTributes has $token]} {
					assert {[lsearch $resolveList $token] == -1} {
						Recursive dependency of token <$token> on itself, while evaluating <$allTokens> against list <$resolveList>.
					}
					set replaced 1
					doEvaluate [$iTributes of $token] tokenized stack [concat $resolveList [list $token]] 
					continue
				}
			} elseif {[string equal -length 2 $token "/\$"]} {
				set token [string range $token 1 end]
				if {[$iTributes has $token]} {
					assert {[lsearch $resolveList $token] == -1} {
						Recursive dependency of token <$token> on itself, while evaluating <$allTokens> against list <$resolveList>.
					}
					set replaced 1
					doEvaluate "/[$iTributes of $token]" tokenized stack [concat $resolveList [list $token]] 
					continue
				}
				set token "/$token"
			} elseif {[regexp "^\\\{(.+)\\\}#(\[1-9]?)$" $token dummy double precision]} {
				# Inline double precision expression evaluation
				set toDouble {}
				set replaced [expr [doEvaluate $double tokenized toDouble $resolveList] || $replaced]
				assert {[string is double -strict $toDouble]} {
					<$double> didn't resolve to a double, but to <$toDouble>.
				}
				if {[string length $precision]} {
					lappend stack [Story::dedouble $toDouble $precision]
				} else {
					lappend stack [Story::dedouble $toDouble]
				}
				continue
			}
			# Take it on face value.
			set tokenized [Story::simplify $tokenized stack $token]
		}
		return $replaced
	}

	variable iAttributes
	variable iResources
	variable iTributes {}
	variable iAttribute ""
	variable iLine ""
}

itcl::class Act {
	inherit Part

	constructor {attributes} {Part::constructor $attributes} {}
	method copy {} {
		set duplicate [chain]
		$duplicate setAct [getAct]
		return $duplicate
	}

	method getAct {} {
		return $iAct
	}
	method setAct {lines} {
		set iAct $lines
	}
	method appendToAct {lines} {
		eval lappend iAct $lines
	}
	method prependToAct {lines} {
		set iAct [eval lappend lines $iAct]
	}

	method isEmpty {} {
		expr ![llength $iAct]
	}

	protected method doRead {I} {
		$I expect line default {
			appendToAct [list [$I get output]]
			$I continue
		}
	}
	protected method doWrite {U} {
		set iIndentation 0
		foreach line $iAct {
			writeLine [string trim $line] $U
		}
		assert {$iIndentation == 0} {
			Unmatched opening bracket in act <[join $iAct "\n"]>.
		}
	}

	protected method writeLine {line U} {
		# Note that for dicts we satisfy ourselves with checking just one angle.
		if {[string first [string index $line 0] "\}\]>"] != -1} {
			# More proper would be to check whether the kind of brackets also matched.
			assert {$iIndentation > 0} {
				Unmatched closing bracket for <$line> in act <[join [getAct] "\n"]>.
			}
			incr iIndentation -1
			$U deindent
		}
		$U write line $line
		if {[string first [string index $line end] "\{\[<"] != -1} {
			incr iIndentation
			$U indent
		}
	}

	variable iAct {}
	protected variable iIndentation
}

itcl::class Sketch {
	inherit Act

	constructor {attributes} {Act::constructor $attributes} {}

	protected method doPrune {variablesPtr} {
		upvar $variablesPtr variables
		foreach line [getAct] {
			detect $line variables
		}
	}

	protected method doRead {I} {
		$I expect line "^%\[$\] " {
			appendToAct [list [$I get unchecked]]
			# Ignore the next line
			$I expect line "^.*$" {}
			$I continue
		} "^%\[$\]/ " {
			appendToAct [list [$I get unchecked]]
			$I continue
		} default {
			appendToAct [list [$I get output]]
			$I continue
		}
	}

	protected method writeLine {line U} {
		set tokenized [evaluate $line replaced]
		if {![string length $tokenized]} {
			$U write line "%$/ $line"
			return
		}
		if $replaced {
			$U write line "%$ $line"
		}

		chain $tokenized $U
	}

}

itcl::class Scene {
	inherit Part

	constructor {attributes} {Part::constructor $attributes} {}
	method copy {} {
		set duplicate [chain]
		foreach actor [getActors] {
			$duplicate createActor $actor
		}
		return $duplicate
	}

	method isEmpty {} {
		expr ![llength $iActors]
	}

	method createActor {actor} {
		assert {![hasActor $actor]} {
			Actor $actor not unique.
		}
		lappend iActors $actor
	}
	method removeActor {pattern} {
		set actorId [lsearch -glob $iActors $pattern]
		if {$actorId == -1} {return 0}
		set iActors [lreplace $iActors $actorId $actorId]
		return 1
	}
	method removeActors {{pattern "*"}} {
		if {[string equal $pattern "*"]} {
			set removed [llength $iActors]
			set iActors {}
			return $removed
		}
		
		for {set removed 0} {[removeActor $pattern]} {incr removed} {}
		return $removed
	}
	method hasActor {pattern} {
		expr [lsearch -glob $iActors $pattern] != -1
	}
	method hasActors {{pattern "*"} args} {
		if {[string equal $pattern "*"]} {
			return [llength $iActors]
		}
		set actors $iActors
		set found 0
		while {[set actorId [eval lsearch -glob $args [list $actors $pattern]]] != -1} {
			incr found
			set actors [lrange $actors [expr $actorId + 1] end]
		}
		return $found
	}
	method getActor {pattern} {
		set actorId [lsearch -glob $iActors $pattern]
		if {$actorId == -1} {return ""}
		lindex $iActors $actorId
	}
	method getActors {{pattern "*"}} {
		if {[string equal $pattern "*"]} {
			return $iActors
		}
		
		set actors $iActors
		set foundActors {}
		while {[set actorId [lsearch -glob $actors $pattern]] != -1} {
			lappend foundActors [lindex $actors $actorId]
			set actors [lrange $actors [expr $actorId + 1] end]
		}
		return $foundActors
	}

	protected method doPrune {variablesPtr} {
		upvar $variablesPtr variables
		if [$iTributes has format] {
			detect [$iTributes of format] variables
		}
		if [$iTributes has operator] {
			detect [$iTributes of operator] variables
		}
	}

	protected method doRead {I} {
		if [$iTributes has format] {
			set format [evaluate [$iTributes of format]]
			assert {[lsearch [lrange $format 0 end-1] raw] == -1} {
				Only the last element of format <$format> can be raw.
			}
		} else {
			set format raw
		}
		set hasOperator [$iTributes has operator]
		if $hasOperator {
			set operator [evaluate [$iTributes of operator]]
			if {![string length $operator]} {set hasOperator 0}
		}
		$I expect line default {
			set act [$I get output]
			set actor ""
			if $hasOperator {
				set at [expr [string length $act] - [string length $operator]]
				assert [string equal [string range $act $at end] $operator] {
					Expected actor <$act> to end with <$operator>.
				}
				if {$at > 0} {
					incr at -1
					assert [string equal [string index $act $at] " "] {
						Expected a space preceding operator <$operator> in <$act>.
					}
				}
				set act [string range $act 0 [incr at -1]]
			}
			foreach type $format {
				if {[lsearch {lstring lname ltext lchar lraw} $type] >= 0} {
					set type [string range $type 1 end]
				} elseif {[lsearch {ustring uname utext uchar uraw} $type] >= 0} {
					set type [string range $type 1 end]
				}
				switch $type string {
					lappend actor [Story::fromString $act act]
				} name {
					lappend actor [Story::fromName $act act]
				} text {
					lappend actor [Story::fromText $act act]
				} char {
					lappend actor [Story::fromChar $act act]
				} boolean {
					lappend actor [Story::fromBoolean $act act]
				} value {
					lappend actor [Story::fromValue $act act]
				} raw {
					lappend actor [string trimleft $act]
				} default {
					assert [string is integer -strict $type] {
						Unrecognized format type <$type> in format <$format>.
					}
					set tokens ""
					for {set idx 0} {$idx < $type} {incr idx} {
						set tokens [concat $tokens [Story::tokenize $act act]]
					}
					lappend actor $tokens
				}
			}
			createActor $actor
			$I continue
		}
	}
	protected method doWrite {U} {
		if [$iTributes has format] {
			set format [evaluate [$iTributes of format]]
			assert {[lsearch [lrange $format 0 end-1] raw] == -1} {
				Only the last element of format <$format> can be raw.
			}
		} else {
			set format raw
		}
		set hasOperator [$iTributes has operator]
		if $hasOperator {
			set operator [evaluate [$iTributes of operator]]
			if {![string length $operator]} {set hasOperator 0}
		}
		foreach actor $iActors {
			set act {}
			foreach type $format acting $actor {
				set operation "eval list"
				if {[lsearch {lstring lname ltext lchar lraw} $type] >= 0} {
					set operation "string tolower"
					set type [string range $type 1 end]
				} elseif {[lsearch {ustring uname utext uchar uraw} $type] >= 0} {
					set operation "string toupper"
					set type [string range $type 1 end]
				}
				switch $type string {
					append act " [Story::toString [eval $operation [list $acting]]]"
				} name {
					append act " [Story::toName [eval $operation [list $acting]]]"
				} text {
					append act " [Story::toText [eval $operation [list $acting]]]"
				} char {
					append act " [Story::toChar [eval $operation [list $acting]]]"
				} boolean {
					append act " [Story::toBoolean $acting]"
				} value {
					append act " [Story::toValue $acting]"
				} raw {
					append act " [eval $operation [list [string trimleft $acting]]"
				} default {
					assert [string is integer -strict $type] {
						Unrecognized format type <$type> in format <$format> for actor <$actor>.
					}
					set tokens [string trim $acting]
					for {set idx 0} {$idx < $type} {incr idx} {
						append act " [Story::tokenize $tokens tokens]"
					}
					assert {![string length $tokens]} {
						More than $type tokens in $acting, can't add <$tokens>.
					}
				}
			}
			if $hasOperator {
				append act " [$iTributes of operator]"
			}
			if [string length $act] {
				set act [string range $act 1 end]
			}
			$U write line $act
		}
	}

	variable iActors {}
}

itcl::class Play {
	inherit Sketch

	constructor {attributes} {Sketch::constructor $attributes} {
		set iSequence [iarray::code [iarray::Sequence #auto]]
	}
	destructor {
		itcl::delete object $iSequence
	}
	method copy {} {
		set duplicate [chain]
		$duplicate setFront [getFront]
		$duplicate setBack [getBack]
		set sequence [$duplicate getSequence]
		foreach {name part} [$iSequence get] {
			$sequence acquire $name [$part copy]
		}
		return $duplicate			
	}

	method hasSequence {} {return 1}
	method getSequence {} {set iPolled 1; return $iSequence}
	method isEmpty {} {
		expr ![llength $iFront] && ![llength $iBack] && ![llength [$iSequence names]]
	}

	protected method doResolve {} {
		foreach {name part} [$iSequence get] {
			$part resolve [$iTributes get]
		}
	}

	protected method doCollect {fontsPtr} {
		upvar $fontsPtr fonts
		foreach {name part} [$iSequence get] {
			$part collect [$iTributes get] fonts
		}
		chain fonts
	}

	protected method doPrune {variablesPtr} {
		upvar $variablesPtr variables
		foreach line [getFront] {
			detect $line variables
		}
		foreach line [getBack] {
			detect $line variables
		}
		foreach {name part} [$iSequence get] {
			foreach variable [$part prune [$iTributes get]] {
				if {[lsearch $variables $variable] == -1} {
					lappend variables $variable
				}
			}
		}
	}

	method getFront {} {
		return $iFront
	}
	method setFront {lines} {
		set iFront $lines
	}
	method appendToFront {lines} {
		set iFront [concat $iFront $lines]
	}
	method prependToFront {lines} {
		set iFront [concat $lines $iFront]
	}

	method getBack {} {
		return $iBack
	}
	method setBack {lines} {
		set iBack $lines
	}
	method appendToBack {lines} {
		set iBack [concat $iBack $lines]
	}
	method prependToBack {lines} {
		set iBack [concat $lines $iBack]
	}
	# Used in deciding whether to add a fake part into an otherwise empty sequence,
	# to be able to separate the front from the back part when reading the file back in.
	# Subclasses that automatically add parts at the back should return 1 instead.
	method hasBack {} {
		return [llength $iBack]
	}

	method getAct {} {if $iPolled {getBack} else {getFront}}
	method setAct {lines} {if $iPolled {setBack $lines} else {setFront $lines}}
	method appendToAct {lines} {if $iPolled {appendToBack $lines} else {appendToFront $lines}}
	method prependToAct {lines} {if $iPolled {prependToBack $lines} else {prependToFront $lines}}

	protected method doRead {I} {
		set iPolled 0
		set afterwards [$I will expect -after]
		$I expect after -xp part -after
		chain $I
		$I expect after -xp $afterwards
		$I will $afterwards
	}
	protected method doWrite {U} {
		set iIndentation 0

		foreach line $iFront {
			writeLine $line $U
		}

		if [llength [$iSequence names]] {
			$U write sequence $iSequence [$iTributes get]
		} elseif {[hasBack]} {
			$iSequence acquire none [iarray::code [Part #auto {}]]
			$U write sequence $iSequence [$iTributes get]
			$iSequence unset none
		}

		foreach line $iBack {
			writeLine $line $U
		}

		assert {$iIndentation == 0} {
			Unmatched opening bracket in play <[join $iFront "\n"]\n[join $iBack "\n"]>.
		}
	}

	variable iSequence
	variable iFront {}
	variable iBack {}
	variable iPolled 0
}

itcl::class Chapter {
	inherit Play

	constructor {attributes} {Play::constructor $attributes} {}
	method copy {} {
		set duplicate [chain]
		$duplicate setTitle [getTitle]
		return $duplicate
	}

	method getTitle {} {return $iTitle}
	method setTitle {title} {set iTitle $title}

	method isEmpty {} {return 0}

	method hasBack {} {return 1}

	protected method doPrune {variablesPtr} {
		upvar $variablesPtr variables
		if [$iTributes has type] {
			detect [$iTributes of type] variables
		}
		if [$iTributes has define] {
			detect [$iTributes of define] variables
		}
		chain variables
	}

	protected method doRead {I} {
		if [$iTributes has type] {
			switch [evaluate [$iTributes of type]] proc {
				set open "\[\{\]"
				set close "\}"
			} array {
				set open "\[\[\]"
				set close "\]"
			} dict {
				set open "<<"
				set close ">>"
			} default {
				set open "\[\{\]"
				set close "\}"
			}
		} else {
			set open "\[\{\]"
			set close "\}"
		}

		$I expect line "^/(\[^ \]+) $open$" {
			set iTitle [$I get match 1]
		}

		chain $I

		if [$iTributes has define] {
			set define [evaluate [$iTributes of define]]
		} else {
			set define def
		}
		assert {[llength $iBack] && [string equal [string trim [lindex $iBack end]] [string trim "$close $define"]]} {
			Expected chapter <$iTitle> to end with <[string trim "$close $define"]>, not <[string trim [lindex $iBack end]]>.
		}
		set iBack [lreplace $iBack end end]
	}

	protected method doWrite {U} {
		if [$iTributes has type] {
			switch [evaluate [$iTributes of type]] proc {
				set open "\{"
				set close "\}"
			} array {
				set open "\["
				set close "\]"
			} dict {
				set open "<<"
				set close ">>"
			} default {
				set open "\{"
				set close "\}"
			}
		} else {
			set open "\{"
			set close "\}"
		}

		$U write line "/$iTitle $open"
		$U indent
		chain $U
		$U deindent

		if [$iTributes has define] {
			set define [evaluate [$iTributes of define]]
		} else {
			set define def
		}
		$U write line [string trim "$close $define"]
	}

	variable iTitle
}
